home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Oberon⁄F™ 1.2 / Preinstalled version / Obx / Mod / Calc / Calc (.txt)
Encoding:
Oberon Document  |  1996-07-08  |  7.0 KB  |  210 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. MODULE ObxCalc;
  17.     IMPORT Stores, Ports, Views, Properties, Controllers, Dialog, Fonts, Strings;
  18.     CONST mm = Ports.mm; CR = 0DX; version = 0;
  19.     TYPE
  20.         Stack = POINTER TO RECORD
  21.             next: Stack;
  22.             val: LONGINT
  23.         END;
  24.         View = POINTER TO RECORD (Views.ViewDesc)
  25.             stack: Stack;
  26.             editMode, enterMode: BOOLEAN
  27.         END;
  28.         font: Fonts.Font;
  29.         labels: ARRAY 21 OF CHAR;
  30.     PROCEDURE LocateField (v: View; f: Views.Frame; x, y: LONGINT; VAR i, j: INTEGER;
  31.                                             VAR valid: BOOLEAN);
  32.     BEGIN
  33.         x := x DIV mm - 3; y := y DIV mm - 12; i := SHORT(x DIV 9); j := SHORT(y DIV 9);
  34.         valid := (i >= 0) & (i < 4) & (j >= 0) & (j < 5) & (x MOD 9 < 7) & (y MOD 9 < 7)
  35.     END LocateField;
  36.     PROCEDURE SelectField (v: View; f: Ports.Frame; i, j: INTEGER);
  37.         CONST point = Ports.point;
  38.         VAR x, y: LONGINT;
  39.     BEGIN
  40.         x := (3 + i * 9) * mm; y := (12 + j * 9) * mm;
  41.         f.MarkRect(x + point, y + point, x + 6 * mm - point, y + 6 * mm - point, Ports.fill, Ports.hilite, TRUE)
  42.     END SelectField;
  43.     PROCEDURE HandleKey (v: View; i, j: INTEGER);
  44.         VAR k, n: INTEGER; s: Stack;
  45.     BEGIN
  46.         k := j*4 + i; s := v.stack;
  47.         IF k IN {0, 1, 2, 3, 7, 11, 15} THEN
  48.             IF s.next # NIL THEN
  49.                 IF k = 0 THEN (* swap *) s := s.next; v.stack.next := s.next; s.next := v.stack; v.stack := s
  50.                 ELSIF k = 1 THEN v.stack := s.next
  51.                 ELSIF k IN {2, 3} THEN
  52.                     IF s.val = 0 THEN Dialog.Beep
  53.                     ELSIF k = 2 THEN s.next.val := s.next.val MOD s.val; v.stack := s.next
  54.                     ELSE s.next.val := s.next.val DIV s.val; v.stack := s.next
  55.                     END
  56.                 ELSIF k = 7 THEN s.next.val := s.next.val * s.val; v.stack := s.next
  57.                 ELSIF k = 11 THEN s.next.val := s.next.val - s.val; v.stack := s.next
  58.                 ELSIF k = 15 THEN s.next.val := s.next.val + s.val; v.stack := s.next
  59.                 END
  60.             ELSE
  61.                 IF k = 0 THEN NEW(s); s.val := 0; s.next := v.stack; v.stack := s
  62.                 ELSIF k = 11 THEN s.val := -s.val
  63.                 ELSIF k = 15 THEN (* skip *)
  64.                 ELSE s.val := 0
  65.                 END
  66.             END;
  67.             v.editMode := FALSE
  68.         ELSIF k = 18 THEN  (* 
  69.             s.val := - s.val
  70.         ELSIF k = 16THEN (* delete *)
  71.             IF v.editMode THEN s.val := s.val DIV 10
  72.             ELSE s.val := 0; v.editMode := TRUE
  73.             END
  74.         ELSIF k = 19 THEN (* enter *)
  75.             NEW(s); s.val := v.stack.val; s.next := v.stack; v.stack := s;
  76.             v.editMode := FALSE
  77.         ELSE (* edit operation *)
  78.             IF k = 17 THEN (* 0 *) n := 0 ELSE n := (3-j)*3 + 1 + i END;
  79.             IF ~v.editMode & ~v.enterMode THEN
  80.                 NEW(s); s.val := n; s.next := v.stack; v.stack := s; v.editMode := TRUE
  81.             ELSIF ~v.editMode THEN s.val := n; v.editMode := TRUE
  82.             ELSIF s.val >= 0 THEN
  83.                 IF s.val > (MAX(LONGINT) - n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val + n END
  84.             ELSE 
  85.                 IF s.val < (MIN(LONGINT) + n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val - n END
  86.             END
  87.         END;
  88.         v.enterMode := k = 19;
  89.         Views.Update(v, Views.keepFrames)
  90.     END HandleKey;
  91.     PROCEDURE Track (v: View; f: Views.Frame; x, y: LONGINT; buttons: SET);
  92.         VAR i, j, i1, j1: INTEGER; isDown, valid, sel: BOOLEAN; m: SET;
  93.     BEGIN
  94.         LocateField(v, f, x, y, i, j, sel);
  95.         IF sel THEN
  96.             SelectField(v, f, i, j);
  97.             REPEAT f.Input(x, y, m, isDown);
  98.                 LocateField(v, f, x, y, i1, j1, valid); 
  99.                 IF ~valid OR (i1 # i) OR (j1 # j) THEN
  100.                     IF sel THEN sel := FALSE; SelectField(v, f, i, j) END
  101.                 ELSE
  102.                     IF ~sel THEN sel := TRUE; SelectField(v, f, i, j) END
  103.                 END
  104.             UNTIL ~isDown;
  105.             IF sel THEN HandleKey(v, i, j); SelectField(v, f, i, j) END
  106.         END
  107.     END Track;
  108.     PROCEDURE Init (v: View);
  109.     BEGIN
  110.         NEW(v.stack); v.stack.val := 0; v.editMode := TRUE; v.enterMode := FALSE
  111.     END Init;
  112.     (* View *)
  113.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  114.     BEGIN
  115.         v.Externalize^(wr);
  116.         wr.WriteVersion(version);
  117.     END Externalize;
  118.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  119.         VAR ver: SHORTINT;
  120.     BEGIN
  121.         v.Internalize^(rd);
  122.         IF ~rd.cancelled THEN
  123.             rd.ReadVersion(version, version, ver);
  124.             IF ~rd.cancelled THEN Init(v) END
  125.         END
  126.     END Internalize;
  127.     PROCEDURE (v: View) CopyFrom (source: Views.View);
  128.     BEGIN
  129.         Init(v)
  130.     END CopyFrom;
  131.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  132.         VAR i, j: INTEGER; x, y: LONGINT; s: ARRAY 2 OF CHAR;
  133.             display: ARRAY 12 OF CHAR;
  134.     BEGIN
  135.         Strings.IntToStringForm(v.stack.val, Strings.decimal, 11, " ", FALSE, display);
  136.         f.DrawRect(0, 0, 40 * mm, 58 * mm, 0, Ports.black);
  137.         f.DrawRect(3 * mm, 3 * mm, 37 * mm, 10 * mm, 0, Ports.black);
  138.         f.DrawString(6 * mm, 8 * mm, Ports.black, display, font);
  139.         j := 0;
  140.         WHILE j # 5 DO
  141.             i := 0; y := (12 + j * 9) * mm;
  142.             WHILE i # 4 DO
  143.                 x := (3 + i * 9) * mm;
  144.                 f.DrawRect(x, y, x + 6 * mm, y + 6 * mm, 0, Ports.black);
  145.                 f.DrawRect(x + mm, y + 6 * mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
  146.                 f.DrawRect(x + 6 * mm, y + Ports.mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
  147.                 s[0] := labels[j * 4 + i]; s[1] := 0X;
  148.                 f.DrawString(x + 3 * mm - font.w DIV 2, y + 3 * mm + font.asc DIV 2, Ports.black, s, font);
  149.                 INC(i)
  150.             END;
  151.             INC(j)
  152.         END
  153.     END Restore;
  154.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  155.                                                                                     VAR focus: Views.View);
  156.         VAR i, j, k: INTEGER;
  157.     BEGIN
  158.         WITH msg: Controllers.PollOpsMsg DO
  159.             msg.valid := {Controllers.pasteChar}
  160.         | msg: Controllers.TrackMsg DO
  161.             Track(v, f, msg.x, msg.y, msg.modifiers)
  162.         | msg: Controllers.EditMsg DO
  163.             IF msg.op = Controllers.pasteChar THEN
  164.                 IF msg.char = CR THEN k := 19
  165.                 ELSIF msg.char = 08X THEN k := 16
  166.                 ELSE
  167.                     k := 0; WHILE (k # 20) & (CAP(labels[k]) # CAP(msg.char)) DO INC(k) END
  168.                 END;
  169.                 IF k < 20 THEN
  170.                     i := k MOD 4; j := k DIV 4;
  171.                     SelectField(v, f, i, j); HandleKey(v, i, j); SelectField(v, f, i, j)
  172.                 END
  173.             END
  174.         ELSE
  175.         END
  176.     END HandleCtrlMsg;
  177.     PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
  178.     BEGIN
  179.         WITH msg: Properties.ResizePref DO
  180.             msg.fixed := TRUE
  181.         | msg: Properties.SizePref DO
  182.             msg.w := 40 * mm; msg.h := 58 * mm
  183.         | msg: Properties.FocusPref DO
  184.             msg.setFocus := TRUE
  185.         ELSE
  186.         END
  187.     END HandlePropMsg;
  188.     (* commands *)
  189.     PROCEDURE Deposit*;
  190.         VAR v: View;
  191.     BEGIN
  192.         NEW(v); Init(v); Views.Deposit(v)
  193.     END Deposit;
  194. BEGIN 
  195.     font := Fonts.dir.This("Courier", 11 * Fonts.point, {}, Fonts.normal);
  196.     labels := "sp
  197. /789*456-123+C0
  198. END  ObxCalc.
  199. TextControllers.StdCtrlDesc
  200. TextControllers.ControllerDesc
  201. Containers.ControllerDesc
  202. Controllers.ControllerDesc
  203. TextRulers.StdRulerDesc
  204. TextRulers.RulerDesc
  205. TextRulers.StdStyleDesc
  206. TextRulers.StyleDesc
  207. TextRulers.AttributesDesc
  208. Helvetica
  209. Documents.ControllerDesc
  210.